Imports System.Runtime.InteropServices
Imports SolidEdgeDraft
Imports SolidEdgeFramework
Module Module1
    Structure Loc
        Public x As Double
        Public y As Double
    End Structure

    Public intctr As Integer
    Public objCallouts As SolidEdgeFrameworkSupport.Balloons
    Public arrayOfAlreadyProcessedBlocks As Hashtable

    Public objSEApp As SolidEdgeFramework.Application
    Public objDraftDoc As SolidEdgeDraft.DraftDocument



    Public port_locs(100) As Loc
    Public objport(100) As Object

    Public n As Integer


    Public ind As Long
    Public x As Double, y As Double, z As Double
    Public x_or As Double, y_or As Double
    Public objRef As Object
    Public objBlockOccNested As Object
    Public objCircle As Object
    Public xMatrix(16) As Double
    Public pt_x As Double
    Public pt_y As Double
    Public pt_z As Double

    Public objblocks As SolidEdgeDraft.Blocks
    Public objBlock As SolidEdgeDraft.Block
    Public objBlockOccurrence As SolidEdgeDraft.BlockOccurrence
    Public objBlockOccurrences As SolidEdgeDraft.BlockOccurrences
    Public ObjOccurrenceReference As Object = Nothing
    Public arrPropertyNames As System.Array
    Public arrTableLocation As System.Array
    Public arrColumnWidths As System.Array




    Public Sub main()

      

        Dim ctr As Integer
        Dim ctr1 As Integer

        Dim objTables As SolidEdgeDraft.Tables = Nothing
        Dim objTable As SolidEdgeDraft.Table = Nothing
        Dim objTitles As SolidEdgeDraft.TableTitles = Nothing
        Dim objTitle As SolidEdgeDraft.TableTitle = Nothing
        Dim objColumns As SolidEdgeDraft.TableColumns = Nothing
        Dim objColumn As SolidEdgeDraft.TableColumn = Nothing
        Dim objRows As SolidEdgeDraft.TableRows = Nothing
        Dim objRow As SolidEdgeDraft.TableRow = Nothing
        Dim ii As Integer
        Dim jj As Integer
        Dim ColumnMap As Hashtable
        Dim viewsCount As Integer = 0
        Dim objParent As Object = Nothing
        Dim objAttributeSets As SolidEdgeFramework.AttributeSets = Nothing
        Dim objAttributeSet As SolidEdgeFramework.AttributeSet = Nothing
        Dim strINI_FileName As String = ""
        Dim strAppPath As String = ""
        Dim objBlockLabels As SolidEdgeDraft.BlockLabelOccurrences = Nothing
        Dim objBlockLabel As SolidEdgeDraft.BlockLabelOccurrence = Nothing
        Dim pp As Integer = 0
        Dim blnPropertyFound As Boolean = False
        Dim kk As Integer = 0





        'currently this utility will only process the the current active sheet in the draft file.
        'if for some reason it is a requirement for the parts list to span multiple sheets
        'you must loop through each sheet witht he code below.



        Try
            arrayOfAlreadyProcessedBlocks = New Hashtable

            Dim n As Integer
            Dim xMatrix(16) As Double
            Dim objCallout As SolidEdgeFrameworkSupport.Balloon
            Dim dblVertices1(2) As Double

            '******* Added because of .NET
            Try
                MyMessageFilter.MessageFilter.Register()
            Catch ex As Exception
                'PrintLine("Error registering message filter.")
            End Try
            '******* Added because of .NET


            strINI_FileName = "BlockPartsListCustomInformation.ini"
            strAppPath = My.Application.Info.DirectoryPath
            strINI_FileName = strAppPath + "\" + strINI_FileName

            ColumnMap = New Hashtable

            'read INI file to pull important information from it including the columns to be shown and location to place the parts list after creation
            Call ReadIni(strINI_FileName)

            Dim TableLocationX As Double = 0.0
            Dim TableLocationY As Double = 0.0

            TableLocationX = CDbl(arrTableLocation(0))
            TableLocationY = CDbl(arrTableLocation(1))

            Try
                objSEApp = Marshal.GetActiveObject("SolidEdge.Application")
            Catch ex As Exception
                MsgBox("Please Open a Solid Edge draft file", MsgBoxStyle.OkOnly)
                End
            End Try

            Try
                objDraftDoc = objSEApp.ActiveDocument
                objSEApp.StatusBar = "Please wait..... processing blocks found on the current draft sheet."
            Catch ex As Exception
                MsgBox("Please Open a Solid Edge draft file", MsgBoxStyle.OkOnly)
                End
            End Try

            objCallouts = objDraftDoc.ActiveSheet.Balloons
            objTables = objDraftDoc.Tables

            If objTables.Count <> 0 Then
                For ii = 1 To objTables.Count
                    If objTables.Item(ii).Titles.Item(1).value = "2D PARTS LIST" Then
                        'would like to get the location of the existing table so the new one created can be laced in the same location
                        'there is a setorigin but not a getorigin API need to file a PR.

                        'just delete the old table and recreate based on the blocks scanned during running this macro
                        objTables.Item(ii).Delete()
                        Dim objSelectSet As SolidEdgeFramework.SelectSet = Nothing
                        objSelectSet = objDraftDoc.SelectSet
                        objSelectSet.RemoveAll()  ' just in case the user has something selected when this command is run.  
                        '                           If do not remove it then it will get deleted below!

                        'need to delete the callouts and recreate them too!  otherwise there will be duplicate callouts
                        For jj = 1 To objCallouts.Count
                            'tag this callout as belonging to the 2d plarts list table
                            objAttributeSets = objCallouts.Item(jj).AttributeSets
                            For pp = 1 To objAttributeSets.Count
                                If objAttributeSets.Item(pp).SetName = "Belongs to 2D PartsList" Then
                                    objSelectSet.Add(objCallouts.Item(jj))  ' the current callout was placed by this utility so needs to be deleted
                                End If
                            Next
                        Next
                        objSelectSet.Delete()  'delete them
                        Garbage_Collect(objAttributeSets)
                        Garbage_Collect(objSelectSet)
                        Exit For
                    End If
                Next

            End If

            objTable = objTables.Add
            objTable.TableStyle = "Normal"
            ' set some table parameters
            objTable.ColumnHeaderPosition = TitlePosition.igHeader
            objTable.ShowColumnHeader = True
            objTable.Margin = 0.00125
            objTable.MaximumRows = 100
            objTable.PageGap = 0.001
            objTable.ReverseDisplayOrder = False

            ' set title parameters
            objTitles = objTable.Titles
            objTitle = objTitles.Add
            objTitle.value = "2D PARTS LIST"
            objTitle.Position = TitlePosition.igHeader


            ' set column parameters
            For ii = 0 To arrPropertyNames.Length - 1
                objColumns = objTable.Columns
                objColumn = objColumns.Add(-1, True)
                objColumn.Header = arrPropertyNames(ii)
                ColumnMap.Add(arrPropertyNames(ii), ii + 1)
                objColumn.Width = arrColumnWidths(ii)
                If arrPropertyNames(ii) = "ITEM NUMBER" Or arrPropertyNames(ii) = "QUANTITY" Or arrPropertyNames(ii) = "QTY" Then
                    objColumn.HeaderAlignment = SolidEdgeFrameworkSupport.TextHorizontalAlignmentConstants.igTextHzAlignCenter
                Else
                    objColumn.DataAlignment = SolidEdgeFrameworkSupport.TextHorizontalAlignmentConstants.igTextHzAlignLeft
                End If
                objColumn.HeaderAlignment = SolidEdgeFrameworkSupport.TextHorizontalAlignmentConstants.igTextHzAlignCenter
                objColumn.Show = True
            Next
            objRows = objTable.Rows
            objblocks = objDraftDoc.Blocks
            objBlockOccurrences = objDraftDoc.ActiveSheet.BlockOccurrences
            n = 0
            For ii = 1 To objBlockOccurrences.Count
                objBlockOccurrence = objBlockOccurrences.Item(ii)
                objBlockOccurrence.Name.ToString()
                ProcessBlockOccurrence(objBlockOccurrence)
            Next
            n = objport.Length
            ctr = 1
            ctr1 = 1

            Dim intTotalNumberofBlocksCtr As Integer = 1
            Dim intUniqueNumberofBlocksCtr As Integer = 1


            For ii = 1 To n - 1
                If Not (objport(ii) Is Nothing) Then
                    If arrayOfAlreadyProcessedBlocks.ContainsKey(objBlockOccurrences.Item(intTotalNumberofBlocksCtr).Block.Name) = False Then
                        objBlockOccurrence = objBlockOccurrences.Item(intTotalNumberofBlocksCtr)
                        blnPropertyFound = False
                        objRow = objRows.Add(-1, True)
                        For jj = 0 To arrPropertyNames.Length - 1
                            If arrPropertyNames(jj) = "ITEM NUMBER" Then
                                objTable.Cell(intUniqueNumberofBlocksCtr, ColumnMap.Item(arrPropertyNames(jj))).value = intUniqueNumberofBlocksCtr   'item number assigned ....  item number 
                                blnPropertyFound = True
                                GoTo skip
                            End If

                            If arrPropertyNames(jj) = "QUANTITY" Or arrPropertyNames(jj) = "QTY" Then
                                objTable.Cell(intUniqueNumberofBlocksCtr, ColumnMap.Item(arrPropertyNames(jj))).value = objBlockOccurrences.Item(intTotalNumberofBlocksCtr).Block.OccurrenceCount
                                blnPropertyFound = True
                                GoTo skip
                            End If

                            If arrPropertyNames(jj) = "NAME" Then
                                objTable.Cell(intUniqueNumberofBlocksCtr, ColumnMap.Item(arrPropertyNames(jj))).value = UCase(objBlockOccurrences.Item(intTotalNumberofBlocksCtr).Block.Name)
                                blnPropertyFound = True
                                GoTo skip
                            End If

                            objBlockLabels = objBlockOccurrence.BlockLabelOccurrences

                            For pp = 1 To objBlockLabels.Count
                                objBlockLabel = objBlockLabels.Item(pp)
                                Dim OccurrencePropertyName As String = UCase(objBlockLabel.Name)
                                Dim OccurrencePropertyValue As String = UCase(objBlockLabel.value)
                                If UCase(OccurrencePropertyName) = arrPropertyNames(jj) Then
                                    objTable.Cell(intUniqueNumberofBlocksCtr, ColumnMap.Item(arrPropertyNames(jj))).value = UCase(OccurrencePropertyValue)
                                    Exit For
                                End If
                            Next
skip:


                            Try
                                If blnPropertyFound = False Then   ' the property must not be a block label so look for it as a simple property stored on the block
                                    'Filed PR there currently is not API access to these properties
                                    objAttributeSets = objBlockOccurrence.Block.AttributeSets
                                    For pp = 1 To objAttributeSets.Count
                                        objAttributeSet = objAttributeSets.Item(pp)
                                        For kk = 1 To objAttributeSet.Count
                                            Dim oName As String = objAttributeSet.Item(kk).Name
                                            If UCase(oName) = arrPropertyNames(jj) Then
                                                objTable.Cell(intUniqueNumberofBlocksCtr, ColumnMap.Item(arrPropertyNames(jj))).value = UCase(objAttributeSet.Item(kk).Value)
                                                Exit For
                                            End If
                                        Next kk
                                    Next pp
                                End If
                            Catch ex As Exception
                                'the API to pull the simple properties stored on the "top" of the block property dialog was added in ST2 MP6
                                '  this API must have errored out so ST2 MP6 or later must not be loaded.
                            End Try

                            blnPropertyFound = False
                        Next jj
                        arrayOfAlreadyProcessedBlocks.Add(objBlockOccurrences.Item(intTotalNumberofBlocksCtr).Block.Name, intUniqueNumberofBlocksCtr)
                        intUniqueNumberofBlocksCtr = intUniqueNumberofBlocksCtr + 1
                    End If
                    objCallout = objCallouts.AddByTerminator(objport(ii), port_locs(ii).x, port_locs(ii).y, 0, False)
                    ' Add a vertex to balloon1 leader line... The vertex should be offset slightly from the connect point
                    dblVertices1(0) = port_locs(ii).x - 0.01
                    dblVertices1(1) = port_locs(ii).y - 0.01

                    Call objCallout.SetVertices(VertexCount:=1, Vertices:=dblVertices1)
                    objCallout.BalloonText = arrayOfAlreadyProcessedBlocks.Item(objBlockOccurrences.Item(intTotalNumberofBlocksCtr).Block.Name).ToString
                    objCallout.Leader = True
                    objCallout.BreakLine = True
                    objCallout.BreakLineDirection = True
                    objCallout.BreakLineDistance = 0.01

                    'tag this callout as belonging to the 2d plarts list table i.e. created by this utility
                    objAttributeSets = objCallout.AttributeSets
                    objAttributeSets.Add("Belongs to 2D PartsList")
                    intTotalNumberofBlocksCtr = intTotalNumberofBlocksCtr + 1
                End If

            Next ii

            objTable.SetOrigin(TableLocationX, TableLocationY)
            objTable.Update()


            objSEApp.StatusBar = "Finished processing."

            Garbage_Collect(objColumn)
            Garbage_Collect(objColumns)
            Garbage_Collect(objRow)
            Garbage_Collect(objRows)
            Garbage_Collect(objTitles)
            Garbage_Collect(objTitle)
            Garbage_Collect(objTable)
            Garbage_Collect(objTables)
            Garbage_Collect(objAttributeSet)
            Garbage_Collect(objAttributeSets)
            Garbage_Collect(objBlockLabel)
            Garbage_Collect(objBlockLabels)
            Garbage_Collect(objBlockOccurrence)
            Garbage_Collect(objBlockOccurrences)
            Garbage_Collect(objblocks)
            Garbage_Collect(objDraftDoc)
            Garbage_Collect(objAttributeSet)
            Garbage_Collect(objAttributeSets)
            Garbage_Collect(objSEApp)

            '******* Added because of .NET
            Try
                MyMessageFilter.MessageFilter.Revoke()
            Catch ex As Exception
                'PrintLine("Error revoking the message filter.")
            End Try
            '******* Added because of .NET

        Catch ex As Exception
            MessageBox.Show("Error encountered: " + ex.Message, "2DPartsList", MessageBoxButtons.OK, MessageBoxIcon.Error, MessageBoxDefaultButton.Button1, MessageBoxOptions.ServiceNotification, False)
        End Try


    End Sub





    

    Public Function ProcessBlockOccurrence(ByVal oBlockOccurrence As SolidEdgeDraft.BlockOccurrence) As Integer

        n = n + 1

        'This call gets the native coordinates of the line in the  block.

        If oBlockOccurrence.BlockView.Lines2d.Count > 0 Then

            If Not (oBlockOccurrence.BlockView.Lines2d.Item(1) Is Nothing) Then
                Call oBlockOccurrence.BlockView.Lines2d.Item(1).GetStartPoint(pt_x, pt_y)  ' hardcoded to hook up the the first line in the block
                objRef = oBlockOccurrence.MemberReference(oBlockOccurrence.BlockView.Lines2d.Item(1))
                GoTo skipToHere
            End If


            If Not (oBlockOccurrence.BlockView.Circles2d.Item(1) Is Nothing) Then
                Call oBlockOccurrence.BlockView.Circles2d.Item(1).GetCenterPoint(pt_x, pt_y)  ' hardcoded to hook up the the first circle in the block
                objRef = oBlockOccurrence.MemberReference(oBlockOccurrence.BlockView.Circles2d.Item(1))
                GoTo skipToHere
            End If

            If Not (oBlockOccurrence.BlockView.Arcs2d.Item(1) Is Nothing) Then
                Call oBlockOccurrence.BlockView.Arcs2d.Item(1).GetStartPoint(pt_x, pt_y)  ' hardcoded to hook up the the first arc in the block
                objRef = oBlockOccurrence.MemberReference(oBlockOccurrence.BlockView.Arcs2d.Item(1))
                GoTo skipToHere
            End If
          
skipToHere:

            Call objRef.GetMatrix(xMatrix)
            Call TransformSourceToCurrent(pt_x, pt_y, xMatrix, port_locs(n).x, port_locs(n).y, n)
            objport(n) = objRef
        End If




    End Function

    

    Public Sub TransformSourceToCurrent(ByVal in_x As Double, ByVal in_y As Double, ByVal xMatrix() As Double, ByVal out_x As Double, ByVal out_y As Double, ByVal num As Integer)

        Dim inv_w As Double  'scale


        inv_w = 1.0# / ((in_x * xMatrix(3)) + (in_y * xMatrix(7)) + (xMatrix(15))) 'Should always be 1.0 (i.e. no perspecitve)

        out_x = ((in_x * xMatrix(0)) + (in_y * xMatrix(4)) + (xMatrix(12))) / inv_w
        out_y = ((in_x * xMatrix(1)) + (in_y * xMatrix(5)) + (xMatrix(13))) / inv_w

        port_locs(n).x = out_x
        port_locs(n).y = out_y

    End Sub


    Sub Garbage_Collect(ByVal obj As Object)

        Try
            '******* Added because of .NET
            If Not (obj Is Nothing) Then
                Marshal.ReleaseComObject(obj)
            End If

            GC.Collect(GC.MaxGeneration)
            GC.WaitForPendingFinalizers()
            GC.Collect(GC.MaxGeneration)
            GC.WaitForPendingFinalizers()
            '******* Added because of .NET
        Catch ex As Exception
            'must not be a COM object
            obj = Nothing
            GC.Collect(GC.MaxGeneration)
            GC.WaitForPendingFinalizers()
            GC.Collect(GC.MaxGeneration)
            GC.WaitForPendingFinalizers()
        End Try

    End Sub

    Public Sub ReadIni(ByVal strFName As String)
        Dim PropertyNamePulled As String = ""
        Dim ii As Integer
        Try
            If System.IO.File.Exists(strFName) = True Then
                Dim strData As String = ""
                Dim arrData As String() = System.IO.File.ReadAllLines(strFName)

                For Each strData In arrData
                    If strData = "" Then
                        Continue For
                    End If

                    Dim strTmp As String = strData

                    If InStr(strTmp.ToUpper, "TableColumns:", CompareMethod.Text) <> 0 Then
                        strTmp = Mid(strTmp, 14, Len(strTmp))
                        arrPropertyNames = strTmp.Split(",")
                        For ii = 0 To arrPropertyNames.Length - 1
                            arrPropertyNames(ii) = UCase(arrPropertyNames(ii))
                        Next
                        GoTo skip
                    End If

                    If InStr(strTmp.ToUpper, "TablePosition:", CompareMethod.Text) <> 0 Then
                        strTmp = Mid(strTmp, 15, Len(strTmp))
                        arrTableLocation = strTmp.Split(",")
                        For ii = 0 To arrTableLocation.Length - 1
                            arrTableLocation(ii) = UCase(arrTableLocation(ii))
                        Next
                        GoTo skip
                    End If


                    If InStr(strTmp.ToUpper, "TableColumnWidths:", CompareMethod.Text) <> 0 Then
                        strTmp = Mid(strTmp, 19, Len(strTmp))
                        arrColumnWidths = strTmp.Split(",")
                        For ii = 0 To arrColumnWidths.Length - 1
                            arrColumnWidths(ii) = UCase(arrColumnWidths(ii))
                        Next
                        GoTo skip
                    End If


skip:
                Next

            End If

        Catch ex As Exception
            MsgBox("Error reading property ini file. " + ex.Message)
        End Try



    End Sub

End Module
